home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
wildcat
/
wc30rec.zip
/
MSGUTIL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-05-12
|
9KB
|
273 lines
type
MsgStatusRec = record
LowMsg,
HighMsg,
ActiveMsg,
LastExtract : Word;
end;
function BuildMsgKey(var Data; Key : Byte) : IsamKeyStr;
var
MsgRec : MsgHeaderType absolute Data;
begin
case Key of
MsgNumberKey : BuildMsgKey := WordToKey(MsgRec.MsgNumber);
MsgOrigNumKey : BuildMsgKey := PackUserName(MsgRec.From)+WordToKey(MsgRec.MsgNumber);
MsgDestNumKey : BuildMsgKey := PackUserName(MsgRec.To_)+WordToKey(MsgRec.MsgNumber);
MsgSubjectKey : BuildMsgKey := Pack6BitKeyUC(MsgRec.Subject, 19)+WordToKey(MsgRec.MsgNumber);
MsgReceiveKey : begin
BuildMsgKey := '';
if (FlagIsSet(MsgRec.MsgFlags, mfReceived)) then
Exit;
if (not FlagIsSet(MsgRec.MsgFlags, mfReceiveable)) then
Exit;
BuildMsgKey := PackUserName(MsgRec.To_)+WordToKey(MsgRec.MsgNumber);
end;
MsgDeleteKey : if (FlagIsSet(MsgRec.MsgFlags, mfDeleted)) then
BuildMsgKey := WordToKey(MsgRec.MsgNumber)
else
BuildMsgKey := '';
end;
end;
procedure PutMsgStatusRec(MSR : MsgStatusRec);
var
LockStatus : Boolean;
MsgHeader : MsgStatusType;
begin
with MsgHeader do
begin
Status := 0;
LowMsg := MSR.LowMsg;
HighMsg := MSR.HighMsg;
ActiveMsg := MSR.ActiveMsg;
LastExtract := MSR.LastExtract;
Len := 12;
Next := 0;
end;
LockStatus := LockBTree(dbMsg);
BtPutRec(MsgFile, StatusRecRefNr, MsgHeader, False);
if (not IsamOk) then
LogFatalError('Error writing message status record', IsamError);
if (LockStatus) then
UnLockBtree(dbMsg);
end;
procedure GetMsgStatusRec(var MSR : MsgStatusRec);
var
MsgHeader : MsgStatusType;
begin
GetBtreeRec(MsgFile, StatusRecRefNr, MsgHeader);
if (not IsamOk) then
LogFatalError('Error reading message status record', IsamError);
with MsgHeader do
begin
MSR.LowMsg := LowMsg;
MSR.HighMsg := HighMsg;
MSR.ActiveMsg := ActiveMsg;
MSR.LastExtract := LastExtract;
end;
end;
procedure ReCalcMsgStatus;
var
TempHigh : Word;
RefNr : LongInt;
Key : IsamKeyStr;
MSR : MsgStatusRec;
LockStatus : Boolean;
begin
LockStatus := LockBTree(dbMsg);
GetMsgStatusRec(MSR);
MSR.ActiveMsg := BtreeUsedKeys(MsgFile, MsgNumberKey) - BtreeUsedKeys(MsgFile, MsgDeleteKey);
Key := WordToKey(0);
NextDiffBtreeKey(MsgFile, MsgNumberKey, RefNr, Key);
if (IsamOk) then
MSR.LowMsg := KeyToWord(Key)
else
MSR.LowMsg := 0;
Key := WordToKey(65535);
PrevDiffBtreeKey(MsgFile, MsgNumberKey, RefNr, Key);
if (IsamOk) then
TempHigh := KeyToWord(Key)
else
TempHigh := 0;
if (TempHigh > MSR.HighMsg) then
MSR.HighMsg := TempHigh;
PutMsgStatusRec(MSR);
if (LockStatus) then
UnLockBtree(dbMsg);
end;
procedure DeleteMsgPrim(MsgHeaderRec : MsgHeaderType; RefNr : LongInt);
var
F : File;
KeyNr : Byte;
Key : IsamKeyStr;
begin
if (MsgHeaderRec.AttachFileName <> '') then
begin
Assign(F, Cfig.MsgAttachPath+MsgHeaderRec.AttachFileName);
Erase(F);
if (IoResult <> 0) then
NoteError('Unable to delete message attachment '+MsgHeaderRec.AttachFileName);
end;
for KeyNr := MsgNumberKey to MsgDeleteKey do
begin
Key := BuildMsgKey(MsgHeaderRec, KeyNr);
if (Key <> '') then
begin
BtDeleteKey(MsgFile, KeyNr, RefNr, Key);
if (not IsamOk) then
LogFatalError(emDeleteMsgKey, IsamError);
end;
end;
BtDeleteVariableRec(MsgFile, RefNr);
if (not IsamOk) then
LogFatalError(emDeleteMsgRec, IsamError);
end;
procedure PurgeFirstMessage;
var
RecSize : Word;
Found : Boolean;
RefNr : LongInt;
Key : IsamKeyStr;
MsgHeaderRec : MsgHeaderType;
begin
Found := False;
ClearBtreeKey(MsgFile, MsgNumberKey);
while (IsamOk) and (not Found) do
begin
NextBtreeKey(MsgFile, RefNr, Key, MsgNumberKey);
if (IsamOk) then
begin
RecSize := SizeOf(MsgHeaderType);
BtGetVariableRecPart(MsgFile, RefNr, MsgHeaderRec, RecSize);
end;
if (IsamOk) and (not FlagIsSet(MsgHeaderRec.MsgFlags, mfNoDelete)) then
begin
Found := True;
DeleteMsgPrim(MsgHeaderRec, RefNr);
end;
end;
end;
procedure AddMsgRec(var MsgRec : MsgRecType);
var
KeyNr : Byte;
RefNr : LongInt;
Key : IsamKeyStr;
MSR : MsgStatusRec;
AddedOk, LockStatus : Boolean;
begin
AddedOk := False;
LockStatus := LockBTree(dbMsg);
ReCalcMsgStatus;
GetMsgStatusRec(MSR);
if (MSR.HighMsg = 65535) then
SendLine('Unable to save, message database is full.')
else
begin
if (ConfDesc.MaxMessages > 0) then
if (BtreeUsedKeys(MsgFile, MsgNumberKey) >= ConfDesc.MaxMessages) then
PurgeFirstMessage;
MsgRec.MsgNumber := Succ(MSR.HighMsg);
if (not FlagIsSet(MsgRec.MsgFlags, mfReceived)) then
begin
MsgRec.ReadTime.D := BadDate;
MsgRec.ReadTime.T := BadTime;
end;
BtFindKey(MsgFile, MsgNumberKey, RefNr, BuildMsgKey(MsgRec, MsgNumberKey));
if (not IsamOk) then
begin
BtAddVariableRec(MsgFile, RefNr, MsgRec, SizeOf(MsgHeaderType)+MsgRec.MsgBytes);
if (not IsamOk) then
LogFatalError('Error adding message in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
for KeyNr := MsgNumberKey to MsgDeleteKey do
begin
Key := BuildMsgKey(MsgRec, KeyNr);
if (Key <> '') then
begin
BTAddKey(MsgFile, KeyNr, RefNr, Key);
if (not IsamOk) then
LogFatalError('Error adding key in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
end;
end;
end;
ReCalcMsgStatus;
AddedOk := True;
end;
if (LockStatus) then
UnLockBtree(dbMsg);
if (AddedOk) then
begin
ReadMInfo(True);
Inc(MInfo.TotalMessages);
Inc(MInfo.TempMsgs);
WriteMInfo;
SetUserHasMail(MsgRec.To_, ConfDesc.ConfNumber);
end;
end;
procedure UpdateMsgRec(var MsgRec : MsgRecType);
var
KeyNr : Byte;
RecSize : Word;
RefNr : LongInt;
Key : IsamKeyStr;
LockStatus : Boolean;
OldMsgHeader : MsgHeaderType;
begin
LockStatus := LockBtree(dbMsg);
FindBtreeKey(MsgFile, RefNr, BuildMsgKey(MsgRec, MsgNumberKey), MsgNumberKey);
if (IsamOk) then
begin
RecSize := SizeOf(OldMsgHeader);
BtGetVariableRecPart(MsgFile, RefNr, OldMsgHeader, RecSize);
if (not IsamOk) then
LogFatalError('Error reading message in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
for KeyNr := MsgNumberKey to MsgDeleteKey do
begin
Key := BuildMsgKey(OldMsgHeader, KeyNr);
if (Key <> '') and (Key <> BuildMsgKey(MsgRec, KeyNr)) then
begin
BtDeleteKey(MsgFile, KeyNr, RefNr, Key);
if (not IsamOk) then
LogFatalError('Error deleting message key in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
end;
end;
BtPutVariableRec(MsgFile, RefNr, MsgRec, SizeOf(MsgHeaderType)+MsgRec.MsgBytes);
if (not IsamOk) then
LogFatalError('Error writing message in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
for KeyNr := MsgNumberKey to MsgDeleteKey do
begin
Key := BuildMsgKey(MsgRec, KeyNr);
if (Key <> '') and (Key <> BuildMsgKey(OldMsgHeader, KeyNr)) then
begin
BtAddKey(MsgFile, KeyNr, RefNr, Key);
if (not IsamOk) then
LogFatalError('Error adding message key in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
end;
end;
end;
if (LockStatus) then
UnLockBtree(dbMsg);
end;